home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / CAD / LISP04.ARJ / EP.LSP < prev    next >
Lisp/Scheme  |  1990-07-30  |  5KB  |  129 lines
  1. ;;;   EP.lsp   Version 1.0
  2. ;;;   Copyright (C) 1990 by Autodesk, Inc.
  3. ;;;  
  4. ;;;   Permission to use, copy, modify, and distribute this software and its
  5. ;;;   documentation for any purpose and without fee is hereby granted.  
  6. ;;;
  7. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. 
  8. ;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF 
  9. ;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
  10. ;;; 
  11. ;;;   By Troy Davis / revised by Steve McCall
  12. ;;;   Autodesk, Inc.  May 1, 1990
  13. ;;;---------------------------------------------------------------------------
  14. ;;; DESCRIPTION
  15. ;;; 
  16. ;;;   EP.LSP  (Enter Point) --  prompts the user for coordinate point entries;
  17. ;;;   makes it easy to distinguish between WCS or UCS Absolute or
  18. ;;;   Relative - or Cartesian, Cylindrical or Spherical entries.
  19. ;;;   (Quick, what is  "@*123<45,67" ???).  You can also reset the
  20. ;;;   "lastpoint" system variable for Relative entries.
  21. ;;;
  22. ;;;   After this Lisp function is loaded <(load "ep")>, it can be
  23. ;;;   used anytime AutoCAD requires a point. Just enter "(ep)"
  24. ;;;   at the point prompt.
  25. ;;;
  26. ;;;   You will then be prompted:
  27. ;;;
  28. ;;;   Exit/World/Absolute to UCS origin/Set lastpoint/<Relative to lastpoint>:
  29. ;;;
  30. ;;;   Enter a letter:  e, w, a, s, or  r<default>, and follow the
  31. ;;;   prompts. "w" (World) also allows Absolute or Relative.
  32. ;;;             
  33. ;;;   The function then assembles the proper point entry, which is
  34. ;;;   given to the AutoCAD prompt and echoed to the screen so you can
  35. ;;;   see how that point would be specified.
  36. ;;;
  37. ;;;   You can enter "E" (Exit) at any time to return to normal point
  38. ;;;   entry; cancelling the function will also cancel the parent
  39. ;;;   command.  All variables are local.  This function cannot be
  40. ;;;   used to respond to an AutoLISP prompt.
  41. ;;;
  42. ;;;---------------------------------------------------------------------------
  43.  
  44.  
  45. (defun myerr (msg)
  46.    (if (/= msg "Function cancelled")
  47.       (princ (strcat "\nError: " msg))
  48.    )
  49.    (setq *error* olderr)
  50.    (princ)
  51. )
  52. (defun ep ( / fp1 fp2 fp3 fp4 fp5 fp6 fp7 fp8 fp9 fp10)
  53.   (setq olderr *error*
  54.         *error* myerr
  55.   )
  56.   (while 
  57.     (not 
  58.       (=
  59.         (progn 
  60.           (initget "Exit World Absolute Set Relative")
  61.           (setq fp1 (getkword (strcat
  62.             "\nExit/World/Absolute to UCS origin/"
  63.             "Set lastpoint/<Relative to lastpoint>: ")))
  64.         )
  65.         "Exit"
  66.       )
  67.     )
  68.     (if (= fp1 "Set")
  69.       (setvar "LASTPOINT" (getpoint "Reference point: "))
  70.       (progn
  71.         (setq fp10 "")
  72.         (if (= fp1 "World")
  73.           (progn
  74.             (initget "Absolute Relative")
  75.             (setq fp10 "World"
  76.                   fp2 (getkword 
  77.                     "Absolute to World origin/<Relative to lastpoint>: ")
  78.             )
  79.             (if (= fp2 "Absolute")
  80.                (setq fp3 "*" fp4 (trans (list 0.0 0.0 0.0) 0 1))
  81.                (setq fp3 "@*" fp4 (getvar "lastpoint"))
  82.             )
  83.           )
  84.           (if (= fp1 "Absolute")
  85.             (setq fp3 "" fp4 (list 0.0 0.0 0.0))
  86.             (setq fp3 "@" fp4 (getvar "lastpoint"))
  87.           )
  88.         )
  89.         (initget "Xyz Spherical Cylindrical")
  90.         (setq fp5 (getkword "Xyz/Cylindrical/<Spherical>: "))
  91.         (initget 1)
  92.         (if (= fp5 "Cylindrical")
  93.           (progn
  94.             (setq fp6 (getdist fp4 "Enter distance in XY plane: "))
  95.             (initget 1) (setq fp7 (getangle fp4 "Enter angle from X: "))
  96.             (initget 1) (setq fp8 (getdist fp4 "Enter displacement along Z: "))
  97.             (setq fp9 (strcat fp3 (rtos fp6) "<" (angtos fp7) "," (rtos fp8)))
  98.           )
  99.           (if (= fp5 "Xyz")
  100.             (progn
  101.               (setq fp6 (getdist (strcat 
  102.                 "Enter displacement along " fp10 " X axis: ")))
  103.               (initget 1) (setq fp7 (getdist (strcat 
  104.                 "Enter displacement along " fp10 " Y axis: ")))
  105.               (initget 1) (setq fp8 (getdist (strcat 
  106.                 "Enter displacement along " fp10 " Z axis: ")))
  107.               (setq fp9 (strcat fp3 (rtos fp6) "," 
  108.                                     (rtos fp7) "," (rtos fp8)))
  109.             )
  110.             (progn
  111.               (setq fp6 (getdist fp4 "Enter 3D Distance: "))
  112.               (initget 1) (setq fp7 (getangle fp4 "Enter Angle from X: "))
  113.               (initget 1) (setq fp8 (getangle fp4 
  114.                 "Enter Angle from XY plane: "))
  115.               (setq fp9 (strcat fp3 (rtos fp6) "<" (angtos fp7) "<" 
  116.                                                    (angtos fp8)))
  117.             )
  118.           )
  119.         )
  120.         (command fp9)
  121.       )
  122.     )
  123.   )
  124.   (setq *error* olderr)
  125.   (princ)
  126. )
  127. (princ "\n\tEp loaded.  Start command with (ep) when a point is requested.")
  128. (princ)
  129.